home *** CD-ROM | disk | FTP | other *** search
/ L' Effet Pommier 3 / L'Effet Pommier - Volume 03.iso / Graphismes / Bitmap / NIH Image 1.59 / Macros / Filters < prev    next >
Text File  |  1995-08-28  |  8KB  |  351 lines

  1. macro 'Unsharp Mask';
  2. var
  3.   I, pid1, pid2: integer;
  4. begin
  5.   pid1 := PidNumber;
  6.   Duplicate(concat(WindowTitle, ' (Unsharp Mask)'));
  7.   pid2 := PidNumber;
  8.   for i := 1 to 8 do
  9.      filter('smooth more');
  10.   ImageMath('subract', pid1, pid2, 1, 0, pid2);
  11. end;
  12.  
  13.  
  14. macro 'Make Bas-relief'
  15. begin
  16.   Duplicate('Bas-relief');
  17.   SelectAll;
  18.   Smooth;
  19.   Copy;
  20.   MoveRoi(-1,-1);  {Try MoveRoi(1,1) for a different effect.}
  21.   Paste;
  22.   Subtract;
  23.   EnhanceContrast;
  24.   ApplyLUT;
  25. end;
  26.  
  27.  
  28. macro 'Normalize to 0 to 255';
  29. {
  30. Similar to enhance contrast but alters the pixel data instead of generating
  31. a LUT function. Can be used to normalize multiple images to the same
  32. brightness scale when creating a poster.
  33. }
  34. var
  35.   min,max,count:integer;
  36. begin
  37.   ResetCounter;
  38.   Measure;
  39.   count:=rCount;
  40.   min :=rMin[count];
  41.   max:=rMax[count];
  42.   KillROI;
  43.   SelectAll;
  44.   AddConstant(-min);
  45.   Max:=Max-min;
  46.   MultiplyByConstant(255/max);
  47.   ShowMessage('Results are best if a ROI is drawn before the macro is executed');
  48.  end;
  49.  
  50. macro 'Subtract Background';
  51. var
  52.   i,Corrected,smoothf:integer;
  53.   scalef:real;
  54. begin
  55.   scalef:=.125;
  56.   smoothf:=10;
  57.   SelectAll;
  58.   Duplicate('Background Corrected');
  59.   Corrected:=PicNumber;
  60.   Duplicate('Background');
  61.   SetScaling('Bilinear'); 
  62.   ScaleSelection(scalef,scalef);
  63.   RestoreRoi;
  64.   for i:=1 to smoothf do begin
  65.     SetOption; Smooth;
  66.   end;
  67.   ScaleSelection(1/scalef,1/scalef);
  68.   ScaleMath(false);
  69.   SelectAll;
  70.   Copy;
  71.   SelectPic(Corrected);
  72.   Paste;
  73.   Subtract;
  74.   ResetGrayMap;
  75. end;
  76.  
  77.  
  78. macro 'Make Variance Image╔';
  79. {
  80. Divides an image into cells, replacing all pixels in each cell by the standard deviation for that cell. You will need to enter the cell width, cell height, and estimated maximum standard deviation. The actual maximum standard deviation is displayed when the macro finishes.
  81. }
  82. var
  83.   x,y,xinc,yinc,width,height:integer;
  84.   cellwidth,cellheight,value:integer;
  85.   maxstd,max:real;
  86. begin
  87.   RequiresVersion(1.58);
  88.   GetPicSize(width,height);
  89.   xinc:=GetNumber('Cell Width:', 16, 0);
  90.   yinc:=GetNumber('Cell Height:', xinc, 0);
  91.   max:=GetNumber('Max std dev:', 50);
  92.   maxstd:=0;
  93.   y:=0;
  94.   repeat
  95.      cellheight:=yinc;
  96.      if (y+cellheight)>height then cellheight:=height-y;
  97.      x:=0;
  98.      repeat
  99.         cellwidth:=xinc;
  100.         if (x+cellwidth)>width then
  101.            cellwidth:=width-x-1;
  102.         MakeRoi(x,y,cellwidth,cellheight);
  103.         measure;
  104.         if rStdDev[rcount]>maxstd
  105.           then maxstd:=rStdDev[rcount];
  106.         value:=trunc(rStdDev[rcount]/max*253)+1;
  107.         if value>254 then value:=254;
  108.         SetForeground(value);
  109.         fill;
  110.         ResetCounter;
  111.         x:=x+xinc;
  112.      until x >= width;
  113.      y:=y+yinc;
  114.   until y >= height;
  115.   KillRoi;
  116.   ShowMessage('max std dev=',maxstd:1:2);
  117. end;
  118.  
  119. procedure Square(scale:real)
  120. { Applies a parabolic LUT}
  121. var i,y:integer;
  122. begin
  123.   for i:= 1 to 254 do begin
  124.     y:= (i-127)*(i-127)*scale/64.25;
  125.     if y > 255 then y:=255;
  126.     RedLUT[i]:=y;
  127.     GreenLUT[i]:= y;
  128.     BlueLUT[i]:=y;
  129.   end;
  130.   UpdateLUT;
  131.   ApplyLUT;
  132. end;
  133.  
  134. procedure ImpulseFilter;
  135. {This is an impulse filter (all zeros with a 1 in the middle) minus a 5x5 average (5x5 1's divided by 25), then scaled so the smallest tap is 1 (i.e. times 25).}
  136. begin
  137.   RequiresVersion(1.53);
  138.   NewTextWindow('5x5 mean diff',150,140);
  139.   writeln('-1 -1 -1  -1 -1');
  140.   writeln('-1 -1 -1  -1 -1');
  141.   writeln('-1 -1 24 -1 -1');
  142.   writeln('-1 -1 -1  -1 -1');
  143.   writeln('-1 -1 -1  -1 -1');
  144.   ScaleConvolutions(true);
  145.   Convolve('');
  146.   Dispose;
  147. end;
  148.  
  149. macro 'Find Variance [V]'
  150. {
  151. Finds the "instantaneous" variance, the variance of a pixel
  152. in its neighborhood.
  153.  
  154.      var(i) = (x(i) - avg(x))^2/(N-1)
  155.  
  156. where avg(x) is the average of values in a neighborhood
  157. (say 5x5) around a pixel x(i), and N is the number of
  158. pixels in the neighborhood (25). Let's disregard the /(N-1)
  159. operation for now -- it's merely a scaling operation. x(i) -
  160. avg(x) can be found by convolving with an appropriate
  161. filter.The squaring operation can be done with a parabolic LUT.  This LUT can include the scaling operation for those who need calibrated results (modify the argument to
  162. "Square" to be other than 1.0 to scale the LUT).
  163.  
  164. Contributed by Norm Hurst (norm_hurst@maca.sarnoff.com).
  165. }
  166. begin
  167.   ImpulseFilter;        {impulse minus 5x5 average}
  168.   Square(1.0);          {Adjust argument to scale the LUT}
  169. end;
  170.  
  171. macro 'Impulse Filter';
  172. begin
  173.   RequiresVersion(1.53);
  174.   ImpulseFilter;
  175. end;
  176.  
  177. macro '3x3 Sharpen [F]';
  178. begin
  179.   NewTextWindow('3x3 sharpen',120,120);
  180.   writeln('-1 -1 -1');
  181.   writeln('-1  9 -1');
  182.   writeln('-1 -1 -1');
  183.   Convolve('');
  184.   Dispose
  185. end;
  186.  
  187. macro '5x5 Laplace';
  188. begin
  189.   NewTextWindow('5x5 laplace',140,120);
  190.   writeln('-1 -1 -1 -1 -1');
  191.   writeln('-1 -1 -1 -1 -1');
  192.   writeln('-1 -1 24 -1 -1');
  193.   writeln('-1 -1 -1 -1 -1');
  194.   writeln('-1 -1 -1 -1 -1');
  195.   Convolve('');
  196.   Dispose;
  197. end;
  198.  
  199. macro '7x7 Gauss';
  200. begin
  201.   NewTextWindow('7x7 gauss',160,140);
  202.   writeln(' 1 1 2  2 2 1 1');
  203.   writeln(' 1 2 2  4 2 2 1');
  204.   writeln(' 2 2 4  8 4 2 2');
  205.   writeln(' 2 4 8 16 8 4 2');
  206.   writeln(' 2 2 4  8 4 2 2');
  207.   writeln(' 1 2 2  4 2 2 1');
  208.   writeln(' 1 1 2  2 2 1 1');
  209.   Convolve('');
  210.   Dispose;
  211. end;
  212.  
  213. procedure Hat13;
  214. begin
  215.   NewTextWindow('13x13 hat',350,200);
  216.   writeln(' 0  0  0  0  0 -1  -1 -1   0  0   0  0  0');
  217.   writeln(' 0  0  0 -1 -1 -2  -2 -2  -1 -1   0  0  0');
  218.   writeln(' 0  0 -2 -2 -3 -3  -4 -3  -3 -2  -2  0  0');
  219.   writeln(' 0 -1 -2 -3 -3 -3  -2 -3  -3 -3  -2 -1  0');
  220.   writeln(' 0 -1 -3 -3 -1  4   6  4  -1 -3  -3 -1  0');
  221.   writeln('-1 -2 -3 -3  4 14  19 14   4 -3  -3 -2 -1');
  222.   writeln('-1 -2 -4 -2  6 19  24 19   6 -2  -4 -2 -1');
  223.   writeln('-1 -2 -3 -3  4 14  19 14   4 -3  -3 -2 -1');
  224.   writeln(' 0 -1 -3 -3 -1  4   6  4  -1 -3  -3 -1  0');
  225.   writeln(' 0 -1 -2 -3 -3 -3  -2 -3  -3 -3  -2 -1  0');
  226.   writeln(' 0  0 -2 -2 -3 -3  -4 -3  -3 -2  -2  0  0');
  227.   writeln(' 0  0  0 -1 -1 -2  -2 -2  -1 -1   0  0  0');
  228.   writeln(' 0  0  0  0  0 -1  -1 -1   0  0   0  0  0');
  229.   Convolve('');
  230.   Dispose;
  231. end;
  232.  
  233. macro '13x13 Hat - scaled';
  234. begin
  235.   ScaleConvolutions(true);
  236.   Hat13;
  237. end;
  238.  
  239. macro '13x13 Hat - clipped';
  240. begin
  241.   ScaleConvolutions(false);
  242.   Hat13;
  243. end;
  244.  
  245. macro 'Unweighted Smoothing╔';
  246. var
  247.   n, row,column:integer;
  248. begin
  249.   n:=GetNumber('Kernel Size[3-63]:',7);
  250.   if (n<3) or (n>63) then begin
  251.     PutMessage('N must be in the range 3-63.');
  252.     exit;
  253.   end;
  254.   NewTextWindow('nxn smooth',300,100);
  255.   for row:=1 to n do begin
  256.     for column:=1 to n do write(' 1');
  257.     writeln;
  258.   end;
  259.   Convolve('');
  260.   Dispose;
  261. end;
  262.  
  263. macro 'Grayscale Erosion';
  264. var
  265.   iterations,i:integer;
  266. begin
  267.   iterations:=GetNumber('Iterations:',1);
  268.   for i:=1 to iterations do
  269.      filter('min');
  270. end;
  271.  
  272. macro 'Grayscale Dilation';
  273. begin
  274.   repeat
  275.      filter('max');
  276.   until button;
  277. end;
  278.  
  279. macro 'Shadow Demo';
  280. begin
  281.    Shadow('N'); wait(1); Undo;
  282.    Shadow('NE'); wait(1); Undo;
  283.    Shadow('E'); wait(1); Undo;
  284.    Shadow('SE'); wait(1); Undo;
  285.    Shadow('S'); wait(1); Undo;
  286.    Shadow('SW'); wait(1); Undo;
  287.    Shadow('W'); wait(1); Undo;
  288.    Shadow('NW'); wait(1); Undo;
  289.    Undo;
  290. end;
  291.  
  292.  
  293. macro 'Fractal Dilation';
  294. var
  295.   iterations,i:integer;
  296. begin
  297.   iterations:=24;
  298.   ResetCounter;
  299.   SetUser1Label('Count');
  300.   SetOptions('User1');
  301.   SetBinaryCount(1);
  302.   Measure;
  303.   rUser1[rCount]:=histogram[255];
  304.   UpdateResults;
  305.   for i:=1 to iterations do begin
  306.      Dilate;
  307.      Measure;
  308.      rUser1[rCount]:=histogram[255];
  309.      UpdateResults;
  310.   end;
  311.   ShowResults;
  312. end;
  313.  
  314.  
  315. macro '(---'; begin end;
  316.  
  317. macro 'Smooth [1]'; begin filter('smooth') end;
  318. macro 'Smooth More [2]'; begin filter('smooth more') end;
  319. macro 'Sharpen [3]'; begin filter('sharpen') end;
  320. macro 'Sharpen More [4]'; begin filter('sharpen more') end;
  321. macro 'Sobel [5]'; begin filter('sobel') end;
  322. macro 'Trace Edges [6]'; begin filter('smooth');
  323.   filter('sobel'); AutoThreshold; MakeBinary end;
  324. macro 'Median [7]'; begin filter('median') end;
  325. macro 'Dither [8]'; begin filter('dither') end;
  326.  
  327.  
  328. macro '(---'; begin end;
  329.  
  330.  
  331. macro '5x5';
  332. {
  333. Note: you only see the open file dialog box the first time one of
  334. these macros is called, since Image keeps track of the folder
  335. containing the convolution kernels.
  336. }
  337. begin
  338.   convolve('Hat(5x5)');
  339. end;
  340.  
  341. macro '7x7'
  342. begin
  343.   convolve('Hat(7x7)');
  344. end;
  345.  
  346. macro '9x9]'
  347. begin
  348.   convolve('Hat(9x9)');
  349. end;
  350.  
  351.